home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / jrh-rkrm-partone / intuition / boopsi / userkmmodel.e < prev   
Text File  |  1995-03-26  |  7KB  |  183 lines
  1. OPT OSVERSION=37
  2.  
  3. MODULE '*rkmmodel',
  4.        'amigalib/boopsi',
  5.        'utility',
  6.        'intuition/classusr',
  7.        'intuition/gadgetclass',
  8.        'intuition/icclass',
  9.        'intuition/imageclass',
  10.        'intuition/intuition'
  11.  
  12. ENUM ERR_NONE, ERR_DRAW, ERR_LIB, ERR_OBJ, ERR_WIN
  13.  
  14. RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL,
  15.       ERR_LIB  IF OpenLibrary()=NIL,
  16.       ERR_OBJ  IF NewObjectA()=NIL,
  17.       ERR_WIN  IF OpenWindowTagList()=NIL
  18.  
  19. CONST PROPID=1, INTEGERID=2, RIGHTID=3, LEFTID=4, PROPWIDTH=80, PROPHEIGHT=10,
  20.       INTWIDTH=50, INTHEIGHT=14, VISIBLE=10, TOTAL=100, INITIALVAL=25
  21. CONST MINWINDOWWIDTH=80, MINWINDOWHEIGHT=PROPHEIGHT+70, MAXCHARS=4
  22.  
  23. DEF w=NIL:PTR TO window, mydrawinfo=NIL, rkmmodcl=NIL,
  24.     rkmmodel=NIL, currval2int=NIL, currval2prop=NIL,
  25.     prop=NIL:PTR TO gadget, integer=NIL:PTR TO gadget,
  26.     leftbut=NIL:PTR TO gadget, rightbut=NIL:PTR TO gadget,
  27.     rightimage=NIL, leftimage=NIL
  28.  
  29. PROC main() HANDLE
  30.   DEF qwe
  31.   utilitybase:=OpenLibrary('utility.library', 37)
  32.   w:=OpenWindowTagList(NIL,
  33.                       [WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR
  34.                                      WFLG_CLOSEGADGET OR WFLG_SIZEGADGET,
  35.                        WA_IDCMP, IDCMP_CLOSEWINDOW,
  36.                        NIL])
  37.   -> E-Note: we could have made initRKMModClass raise an exception
  38.   IF rkmmodcl:=initRKMModClass()
  39.     mydrawinfo:=GetScreenDrawInfo(w.wscreen)
  40.     makeGadgetsAndRKMModel()
  41.     doMethodA(rkmmodel, [OM_ADDMEMBER, currval2prop])
  42.     currval2prop:=NIL  -> E-Note: this is now part of the rkmmodel object
  43.     doMethodA(rkmmodel, [OM_ADDMEMBER, currval2int])
  44.     currval2int:=NIL   -> E-Note: again, now part of the rkmmodel object
  45.     WindowLimits(w,
  46.                  w.borderleft+w.borderright+integer.leftedge+integer.width+10,
  47.                  w.bordertop+w.borderbottom+prop.height+10,
  48.                  w.maxwidth,
  49.                  w.maxheight)
  50.     AddGList(w, prop, -1, -1, NIL)
  51.     RefreshGadgets(prop, w, NIL)
  52.  
  53.     GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe})
  54.     WriteF('RKMMOD_CURRVAL = \d\n', qwe)
  55.     Delay(200)
  56.  
  57.     IF SetAttrsA(rkmmodel, [RKMMOD_CURRVAL, 10, NIL])
  58.       RefreshGadgets(prop, w, NIL)
  59.     ENDIF
  60.     GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe})
  61.     WriteF('RKMMOD_CURRVAL = \d\n', qwe)
  62.     Delay(200)
  63.  
  64.     IF SetAttrsA(rkmmodel, [RKMMOD_CURRVAL, 30, NIL])
  65.       RefreshGadgets(prop, w, NIL)
  66.     ENDIF
  67.     GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe})
  68.     WriteF('RKMMOD_CURRVAL = \d\n', qwe)
  69.     Delay(200)
  70.  
  71.     IF SetAttrsA(rkmmodel, [RKMMOD_CURRVAL, 50, NIL])
  72.       RefreshGadgets(prop, w, NIL)
  73.     ENDIF
  74.     GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe})
  75.     WriteF('RKMMOD_CURRVAL = \d\n', qwe)
  76.     Delay(200)
  77.  
  78.     IF SetAttrsA(rkmmodel, [RKMMOD_UP, 1, NIL])
  79.       RefreshGadgets(prop, w, NIL)
  80.     ENDIF
  81.  
  82.     -> Wait for the user to click window close gadget
  83.     REPEAT
  84.     UNTIL WaitIMessage(w)=IDCMP_CLOSEWINDOW
  85.     RemoveGList(w, prop, -1)
  86.   ENDIF
  87.  
  88. EXCEPT DO
  89.   IF currval2int  THEN DisposeObject(currval2int)
  90.   IF currval2prop THEN DisposeObject(currval2prop)
  91.   IF rightbut     THEN DisposeObject(rightbut)
  92.   IF leftbut      THEN DisposeObject(leftbut)
  93.   IF integer      THEN DisposeObject(integer)
  94.   IF prop         THEN DisposeObject(prop)
  95.   IF rkmmodel     THEN DisposeObject(rkmmodel)
  96.   IF leftimage    THEN DisposeObject(leftimage)
  97.   IF rightimage   THEN DisposeObject(rightimage)
  98.  
  99.   IF mydrawinfo THEN FreeScreenDrawInfo(w.wscreen, mydrawinfo)
  100.   IF rkmmodcl THEN freeRKMModClass(rkmmodcl)
  101.   IF w THEN CloseWindow(w)
  102.   IF utilitybase THEN CloseLibrary(utilitybase)
  103.   SELECT exception
  104.   CASE ERR_DRAW; WriteF('Error: Failed to get screen DrawInfo\n')
  105.   CASE ERR_LIB;  WriteF('Error: Failed to open utility library\n')
  106.   CASE ERR_OBJ;  WriteF('Error: Failed to make new Object\n')
  107.   CASE ERR_WIN;  WriteF('Error: Failed to open window\n')
  108.   ENDSELECT
  109. ENDPROC
  110.  
  111. PROC makeGadgetsAndRKMModel() HANDLE
  112.   rightimage:=NewObjectA(NIL, 'sysiclass',
  113.                         [SYSIA_WHICH, RIGHTIMAGE,
  114.                          SYSIA_DRAWINFO, mydrawinfo, NIL])
  115.   leftimage:=NewObjectA(NIL, 'sysiclass',
  116.                        [SYSIA_WHICH, LEFTIMAGE,
  117.                         SYSIA_DRAWINFO, mydrawinfo, NIL])
  118.   rkmmodel:=NewObjectA(rkmmodcl, NIL,
  119.                       [RKMMOD_CURRVAL, INITIALVAL,
  120.                        RKMMOD_LIMIT, TOTAL-VISIBLE, NIL])
  121.   prop:=NewObjectA(NIL, 'propgclass',
  122.                   [GA_ID,       PROPID,
  123.                    GA_TOP,      w.bordertop+5,
  124.                    GA_LEFT,     w.borderleft+5,
  125.                    GA_WIDTH,    PROPWIDTH,
  126.                    GA_HEIGHT,   PROPHEIGHT,
  127.                    ICA_MAP,    [PGA_TOP, RKMMOD_CURRVAL,
  128.                                 STRINGA_LONGVAL, RKMMOD_CURRVAL,
  129.                                 NIL],
  130.                    ICA_TARGET,  rkmmodel,
  131.                    PGA_FREEDOM, FREEHORIZ,
  132.                    PGA_TOTAL,   TOTAL,
  133.                    PGA_TOP,     INITIALVAL,
  134.                    PGA_VISIBLE, VISIBLE,
  135.                    PGA_NEWLOOK, TRUE,
  136.                    NIL])
  137.   integer:=NewObjectA(NIL, 'strgclass',
  138.                      [GA_ID,       INTEGERID,
  139.                       GA_TOP,      w.bordertop+5,
  140.                       GA_LEFT,     prop.leftedge+prop.width+48,
  141.                       GA_WIDTH,    INTWIDTH,
  142.                       GA_HEIGHT,   INTHEIGHT,
  143.                       ICA_MAP,    [PGA_TOP, RKMMOD_CURRVAL,
  144.                                    STRINGA_LONGVAL, RKMMOD_CURRVAL,
  145.                                    NIL],
  146.                       ICA_TARGET,  rkmmodel,
  147.                       GA_PREVIOUS, prop,
  148.                       STRINGA_LONGVAL,  INITIALVAL,
  149.                       STRINGA_MAXCHARS, MAXCHARS,
  150.                       NIL])
  151.   leftbut:=NewObjectA(NIL, 'buttongclass',
  152.                      [GA_ID,       LEFTID,
  153.                       GA_IMAGE,    leftimage,
  154.                       GA_TOP,      w.bordertop+5,
  155.                       GA_LEFT,     prop.leftedge+prop.width,
  156.                       ICA_MAP,    [GA_ID, RKMMOD_DOWN, NIL],
  157.                       ICA_TARGET,  rkmmodel,
  158.                       GA_PREVIOUS, integer,
  159.                       NIL])
  160.   rightbut:=NewObjectA(NIL, 'buttongclass',
  161.                       [GA_ID,       RIGHTID,
  162.                        GA_IMAGE,    rightimage,
  163.                        GA_TOP,      w.bordertop+5,
  164.                        GA_LEFT,     prop.leftedge+prop.width+leftbut.width,
  165.                        ICA_MAP,    [GA_ID, RKMMOD_UP, NIL],
  166.                        ICA_TARGET,  rkmmodel,
  167.                        GA_PREVIOUS, leftbut,
  168.                        NIL])
  169.   currval2prop:=NewObjectA(NIL, 'icclass',
  170.                           [ICA_MAP,    [RKMMOD_CURRVAL, PGA_TOP, NIL],
  171.                            ICA_TARGET,  prop,
  172.                            NIL])
  173.   currval2int:=NewObjectA(NIL, 'icclass',
  174.                          [ICA_MAP,    [RKMMOD_CURRVAL, STRINGA_LONGVAL, NIL],
  175.                           ICA_TARGET,  integer,
  176.                           NIL])
  177.   RETURN TRUE
  178. EXCEPT
  179.   ReThrow()  -> E-Note: pass on exception if it is an error
  180. ENDPROC
  181.  
  182. vers: CHAR 0, '$VER: UseRKMModel 37.1', 0
  183.